home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 004 / heareye.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1986-10-30  |  4.3 KB  |  119 lines
  1. 10  KEY OFF
  2. 20   SCREEN 0,0,0:WIDTH 80:CLS:DEF SEG:POKE 106,0
  3. 30   ON KEY(10) GOSUB 200
  4. 40   KEY(10) ON
  5. 50   GOSUB 1080:DEF SEG:POKE 106,0:COLOR 11,0
  6. 60   LOCATE 1,19:PRINT "VARPTR"STRING$(42,196)"COLOR"
  7. 70   LOCATE 3,19:PRINT "CLS"STRING$(42,196)"'"
  8. 80   LOCATE 2,19:PRINT "CALL"SPC(42)"CALL"
  9. 90   COLOR 0,7
  10. 100  LOCATE  2,29:PRINT CHR$(255) "F R I E N D L Y W A R E" CHR$(255)
  11. 110  LOCATE  7,28:COLOR 7,0:PRINT"   Hearing And Eye Test"
  12. 120  LOCATE 11,32:COLOR 0,7:PRINT " 1 ";:COLOR 3,0:PRINT"   Hearing Test"
  13. 130  LOCATE 13,32:COLOR 0,7:PRINT " 2 ";:COLOR 3,0:PRINT"   Eye Test"
  14. 140  LOCATE 19,13:COLOR 15,0:PRINT"*****";:COLOR 3,0:PRINT" Strike Key Corresponding To Function Desired ";:COLOR 15,0:PRINT"*****":COLOR 3,0
  15. 150  LOCATE 25,23:COLOR 0,7:PRINT " Strike <F10> To Leave This Program ";:COLOR 3,0
  16. 160  RESP$=INKEY$:IF RESP$="" THEN 160
  17. 170  IF RESP$="2" THEN GOSUB 210:GOTO 10
  18. 180  IF RESP$="1" THEN GOSUB 700:GOTO 10
  19. 190  GOTO 160
  20. 200  RUN"menu
  21. 210  REM *** BEGIN EYE CHART
  22. 220  CLS:PRINT STRING$(80,219)
  23. 230  FOR A=2 TO 22:LOCATE A,1:PRINT "CSRLIN":LOCATE A,80:PRINT "CSRLIN":NEXT
  24. 240  LOCATE 23,1:PRINT STRING$(80,219);
  25. 250  COLOR 15,0
  26. 260  LOCATE 3,32:PRINT "HOME VISION TEST":COLOR 3,0
  27. 270  LOCATE 5,15:PRINT "This test is not a replacement for  regular visits
  28. 280  LOCATE 6,15:PRINT "to your doctor. Only he can conduct a complete and
  29. 290  LOCATE 7,15:PRINT "thorough examination.
  30. 300  LOCATE 9,15:PRINT "To  test your vision,  stand back 20 feet from the
  31. 310  LOCATE 10,15:PRINT"screen.  Place a hand  over  one  eye and  without
  32. 320  LOCATE 11,15:PRINT"squinting, see if you can tell in which  direction
  33. 330  LOCATE 12,15:PRINT "the character arms are pointing.
  34. 340  LOCATE 14,15:PRINT"At 20 feet,  a person with normal vision should be
  35. 350  LOCATE 15,15:PRINT"able to correctly `read' the line marked 20/20.
  36. 360  LOCATE 17,15:PRINT"Repeat  the test  for your  other eye  and then on
  37. 370  LOCATE 18,15:PRINT "both eyes at once.
  38. 380  LOCATE 25,27:COLOR 15,0:PRINT "Strike Any Key To Continue";
  39. 390  A$=INKEY$:IF A$="" THEN 390
  40. 400  COLOR 0,7,3
  41. 410  CLS
  42. 420  PRINT
  43. 430  PRINT "            <UNK! {FFDE}>CSRLINCSRLINCSRLINCSRLINCSRLINCSRLINCSRLINCSRLINCSRLIN     INKEY$CSRLINCSRLINCSRLINCSRLINCSRLINCSRLINCSRLINCSRLINOFF     CSRLINCSRLINCSRLINCSRLINCSRLINCSRLINCSRLINCSRLINCSRLINOFF     CSRLINCSRLINOFFINKEY$CSRLINCSRLIN CSRLINCSRLINOFF"
  44. 440  PRINT "             INKEY$CSRLINCSRLINPOINTPOINTPOINTPOINTPOINTPOINTPOINT     INKEY$CSRLINCSRLIN CSRLINCSRLIN CSRLINCSRLINOFF     POINTPOINTPOINTPOINTPOINTPOINTPOINTCSRLINCSRLINOFF     CSRLINCSRLINOFFINKEY$CSRLINCSRLIN CSRLINCSRLINOFF"
  45. 450  PRINT " 20/50       INKEY$CSRLINCSRLIN<0xDF!><0xDF!><0xDF!><0xDF!><0xDF!><0xDF!><0xDF!>     INKEY$CSRLINCSRLIN CSRLINCSRLIN CSRLINCSRLINOFF     <0xDF!><0xDF!><0xDF!><0xDF!><0xDF!><0xDF!><0xDF!>CSRLINCSRLINOFF     CSRLINCSRLINOFFINKEY$CSRLINCSRLIN CSRLINCSRLINOFF"
  46. 460  PRINT "             INKEY$CSRLINCSRLINCSRLINCSRLINCSRLINCSRLINCSRLINCSRLINCSRLIN     INKEY$CSRLINCSRLIN CSRLINCSRLIN CSRLINCSRLINOFF     CSRLINCSRLINCSRLINCSRLINCSRLINCSRLINCSRLINCSRLINCSRLINOFF     CSRLINCSRLINCSRLINCSRLINCSRLINCSRLINCSRLINCSRLINCSRLINOFF"
  47. 470  PRINT
  48. 480  PRINT
  49. 490  PRINT "                CSRLIN<0xDF!><0xDF!><0xDF!><0xDF!>      <0xDF!><0xDF!><0xDF!><0xDF!>CSRLIN      CSRLIN CSRLIN CSRLIN      CSRLIN<0xDF!>CSRLIN<0xDF!>CSRLIN      CSRLIN<0xDF!><0xDF!><0xDF!><0xDF!>
  50. 500  PRINT " 20/40          CSRLIN<0xDF!><0xDF!><0xDF!><0xDF!>      <0xDF!><0xDF!><0xDF!><0xDF!>CSRLIN      CSRLIN CSRLIN CSRLIN      CSRLIN CSRLIN CSRLIN      CSRLIN<0xDF!><0xDF!><0xDF!><0xDF!>"
  51. 510  PRINT "             <UNK! {FF20}> <0xDF!><0xDF!><0xDF!><0xDF!><0xDF!>      <0xDF!><0xDF!><0xDF!><0xDF!><0xDF!>      <0xDF!><0xDF!><0xDF!><0xDF!><0xDF!>      <0xDF!> <0xDF!> <0xDF!>      <0xDF!><0xDF!><0xDF!><0xDF!><0xDF!>"
  52. 520  PRINT
  53. 530  PRINT "                   CSRLIN<0xDF!><0xDF!><0xDF!>    CSRLIN<0xDF!><0xDF!>CSRLIN    CSRLIN  CSRLIN    CSRLIN<0xDF!><0xDF!>CSRLIN    <0xDF!><0xDF!><0xDF!>CSRLIN    CSRLIN  CSRLIN"
  54. 540  PRINT " 20/30             CSRLINPOINTPOINTPOINT    CSRLIN  CSRLIN    CSRLINPOINTPOINTCSRLIN    CSRLIN  CSRLIN    POINTPOINTPOINTCSRLIN    CSRLINPOINTPOINTCSRLIN"
  55. 550  PRINT
  56. 560  PRINT "                      POINTPOINTPOINT    POINTPOINTPOINT    POINT POINT    POINTPOINTPOINT    POINTPOINTPOINT    POINT POINT"
  57. 570  PRINT " 20/20                CSRLIN CSRLIN    CSRLINPOINTPOINT    CSRLINPOINTCSRLIN    CSRLIN CSRLIN    POINTPOINTCSRLIN    CSRLINPOINTCSRLIN"
  58. 580  PRINT
  59. 590  PRINT " 20/15                INKEY$POINTOFF  INKEY$<0xDF!>OFF  INKEY$<0xDF!>OFF  INKEY$POINTOFF  INKEY$<0xDF!>OFF  INKEY$POINTOFF  INKEY$<0xDF!>OFF  INKEY$POINTOFF"
  60. 600  PRINT
  61. 610  PRINT " 20/10                  U  OR  OR  U  U  OR  U  OR  OR  U  OR  U  "
  62. 620  PRINT
  63. 630  PRINT " 20/5                     n u n u n n u n u u n n u u n n   "
  64. 640  PRINT
  65. 650  LOCATE 24,23 :PRINT "*** Strike Any Key To Return To Menu ***";
  66. 660  A$=INKEY$ :IF A$="" THEN 660
  67. 670  COLOR 7,0 :CLS
  68. 680  COLOR ,,0
  69. 690  RETURN
  70. 700  CLS:PRINT STRING$(80,219)
  71. 710  FOR A=2 TO 22:LOCATE A,1:PRINT "CSRLIN":LOCATE A,80:PRINT "CSRLIN":NEXT
  72. 720  LOCATE 23,1:PRINT STRING$(80,219);
  73. 730  COLOR 15,0:LOCATE 3,32:PRINT "HOME HEARING TEST":COLOR 3,0
  74. 740  LOCATE 5,15:PRINT "This test is not a replacement for  regular visits
  75. 750  LOCATE 6,15:PRINT "to your doctor. Only he can conduct a complete and
  76. 760  LOCATE 7,15:PRINT "thorough examination.
  77. 770  LOCATE 9,15:PRINT "To  test your hearing, strike any key to begin the
  78. 780  LOCATE 10,15:PRINT"tone. When you can no longer hear the tone,  again
  79. 790  LOCATE 11,15:PRINT"strike any key.
  80. 800  LOCATE 13,15:PRINT"In  our testing  here at home,  we have found that
  81. 810  LOCATE 14,15:PRINT"most people will lose the tone near  15,000 cycles
  82. 820  LOCATE 15,15:PRINT"per second. The circuitry within the IBM P C  will
  83. 830  LOCATE 16,15:PRINT"handle 32,000 cycles per second, but we had no way
  84. 840  LOCATE 17,15:PRINT"to evaluate the capacity of the speaker.
  85. 850  LOCATE 25,27:COLOR 15,0:PRINT "Strike Any Key To Continue";
  86. 860  A$=INKEY$:IF A$="" THEN 860
  87. 870  CLS:PLAY "MF"
  88. 880  J=1
  89. 890  COLOR 3,0
  90. 900  LOCATE 10,25 :PRINT "This Test Is Designed For Home Use Only.";
  91. 910  COLOR 15,0 :LOCATE 12,20 :PRINT "      *** Strike Any Key To Start Test ***";
  92. 920  B$=INKEY$:IF B$="" THEN 920
  93. 930  LOCATE 12,20 :PRINT "*** Strike Any Key When Pitch Cannot Be Heard ***";
  94. 940  DEF SEG: POKE 106,0
  95. 950  FOR I=100 TO 30000 STEP 100
  96. 960  SOUND I,J
  97. 970  IF I=14000 THEN J=10
  98. 980  B$=INKEY$:IF B$<>"" THEN 1000
  99. 990  NEXT I
  100. 1000  REM STOP TEST
  101. 1010  COLOR 3,0
  102. 1020  LOCATE 12,1 :PRINT SPC(79);
  103. 1030  LOCATE 14,20,0  : PRINT "     Key Was Struck At"; I ;"Cycles Per Second     ";
  104. 1040  COLOR 15,0
  105. 1050  LOCATE 25,25 :PRINT "*** Strike Any Key To Return To Menu ***";
  106. 1060  B$=INKEY$ :IF B$="" THEN 1060
  107. 1070  RETURN
  108. 1080  ON KEY(1) GOSUB 1180
  109. 1090  ON KEY(2) GOSUB 1180
  110. 1100  ON KEY(3) GOSUB 1180
  111. 1110  ON KEY(4) GOSUB 1180
  112. 1120  ON KEY(5) GOSUB 1180
  113. 1130  ON KEY(6) GOSUB 1180
  114. 1140  ON KEY(7) GOSUB 1180
  115. 1150  ON KEY(8) GOSUB 1180
  116. 1160  ON KEY(9) GOSUB 1180
  117. 1170  FOR A=1 TO 9:KEY(A) ON:NEXT
  118. 1180  RETURN
  119.